home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-03
/
imb9102.zip
/
CMDPARSE.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-02-18
|
20KB
|
609 lines
' *******************************************
' ** **
' ** "DOS Command Line Parse Engine" **
' ** Version 0.99 - 12/20/90 **
' ** **
' *******************************************
' This is a group of procedures that form a "parse engine" for
' DOS. The "parse engine" breaks COMMAND$ down into individual
' switches and checks the switch against a given list of legal
' switches and "switch aliases". If the switch is legal up to
' this point, it is checked further for correct syntax (i.e.
' legal parameters, etc.)
' The general syntax that is accepted by the "parse engine" is:
'
' PROGNAME [InputFileSpec [OutputFileSpec]] [Switches]
'
' NOTE: PROGNAME stands for the name of the program being
' executed, which is NOT part of the data checked by
' the "parse engine".
' $DYNAMIC
DEFINT A-Z
CONST FALSE = 0, TRUE = NOT FALSE
CONST ValidSymbol$ = "/-#" ' Set equivalent switch symbols
TYPE NumericParameterType
Minimum AS INTEGER
Maximum AS INTEGER
Default AS INTEGER
END TYPE
DECLARE FUNCTION BaseFilename$ (Filespec$)
DECLARE FUNCTION BTRIM$ (Argument$)
DECLARE FUNCTION Extension$ (Filespec$)
DECLARE FUNCTION FinishedFilespec$ (Filespec$, DefaultFilepec$)
DECLARE FUNCTION NumericSwitchValue (SwitchNameToCheck$)
DECLARE FUNCTION TextSwitchValue$ (SwitchNameToCheck$)
DECLARE SUB GetLegalSwitches ()
DECLARE SUB ParseFilespecs (DefaultInputName$,DefaultOutputName$)
DECLARE SUB ParseSwitches ()
DECLARE SUB RunParseEngine () ' Demonstrate the "parse engine"
ON ERROR GOTO Oops
OPTION BASE 1
'BEGINNING OF SECTION 1 OF 3 FOR QBX 7.X USERS
DIM SwitchName$(1), SwitchAlias$(1), SwitchType(1)
DIM NumericParameter(1) AS NumericParameterType
DIM SwitchValue(1), SwitchText$(1)
'END SECTION 1 OF 3 FOR QBX 7.X USERS
'BEGINNING OF SECTION 1 OF 3 FOR QB 4.X USERS
'NbrParms = 8
'DIM SwitchName$(NbrParms), SwitchAlias$(NbrParms),
'DIM SwitchType(NbrParms)
'DIM NumericParameter(NbrParms) AS NumericParameterType
'DIM SwitchValue(NbrParms), SwitchText$(NbrParms)
'END OF SECTION 1 OF 3 FOR QB 4.X USERS
RunParseEngine
END
LegalSwitchList:
' All the information regarding the switches (and their
' aliases) is kept here. The first item of each line is
' a legal switch name, followed by an alias name for that
' switch. The next data item is an integer value that
' classifies the type of data associated with the
' corresponding switch. This value governs exactly what
' subsequent data is expected to be read next. The format
' of each line of data is as follows:
' DATA SWITCH,ALIAS,0 NO PARAMETERS ALLOWED
' DATA SWITCH,ALIAS,1,Min,Max,Default Opt # parm accepted
' DATA SWITCH,ALIAS,2 Opt Text parm accepted
' DATA SWITCH,ALIAS,3,Min,Max,Default Opt Text OR # parm
' DATA SWITCH,ALIAS,-1,Min,Max # parm REQUIRED
' DATA SWITCH,ALIAS,-2 Text parm REQUIRED
' DATA SWITCH,ALIAS,-3,Min,Max Text OR # parm RQD
' NOTE: A local error handler is used to trap an "Out of data"
' error, so the GetLegalSwitches procedure ends gracefully, and
' no "sentinel" data is required here.
DATA B,BATCH,0
DATA D,DECODE,-1,1,3
DATA E,ENCODE,1,0,2,0
DATA H,HELP,0
DATA L,LOCK,0
DATA S,SORT,2
DATA X,ERR,0
DATA ?,,0
Oops:
' This is an error handler designed to trap the custom error
' codes generated by the SUB ParseSwitches. The custom errors
' are:
' Error Code Condition
' ========== =========
' 200 Switch is illegal (not part of LegalSwitchList)
' 201 Missing required switch parameter
' 202 Switch has a parameter but should not have one
' 203 Numeric/Text mismatch
' 204 Illegal parameter quantity
' 205 Switch has been duplicated
SELECT CASE ERR
CASE 200
PRINT "Unknown switch: "; BadSwitch$
CASE 201
PRINT "Missing parameter in switch: "; BadSwitch$
CASE 202
PRINT "Extraneous parameter in switch: "; BadSwitch$
CASE 203
PRINT "Parameter type mismatch in switch: "; BadSwitch$
CASE 204
PRINT "Illegal quantity in switch: "; BadSwitch$
CASE 205
PRINT "Duplicate switch: "; BadSwitch$
CASE ELSE
PRINT "BASIC run-time error #"; MID$(STR$(ERR), 2)
END SELECT
'BEGINNING OF SECTION 2 OF 3 FOR QBX 7.X USERS
END ERR ' All errors are trapped, so RESUME is not necessary
'END OF SECTION 2 OF 3 FOR QBX 7.X USERS
'BEGINNING OF SECTION 2 OF 3 FOR QB 4.X USERS
' END
'END OF SECTION 2 OF 3 FOR QB 4.X USERS
FUNCTION BaseFilename$ (Filespec$) STATIC
' This FUNCTION returns a truncated Filespec$, with the
' extension cut off. If Filespec$ had a trailing period only
' with no extension, the trailing period is not removed. This
' will signal ParseFilespecs to not append a default file
' extension onto Filespec$, when requested.
Position = INSTR(Filespec$, ".")
SELECT CASE Position
CASE 0, LEN(Filespec$)
Build$ = Filespec$ ' leave "as is"...
CASE 1
Build$ = ""
CASE ELSE
Build$ = LEFT$(Build$, Position - 1)
END SELECT
BaseFilename$ = Build$
END FUNCTION
REM $STATIC
FUNCTION BTRIM$ (Argument$) STATIC
BTRIM$ = RTRIM$(LTRIM$(Argument$)) ' BTRIM for "BOTH TRIM".
END FUNCTION
FUNCTION Extension$ (Filespec$) STATIC
' This FUNCTION returns only the FILE EXTENSION of a given
' FileSpec, if one exists in the FileSpec parameter. Extensions
' are parsed only where it is legal for them to be present.
IF LEN(Filespec$) > 4 THEN
Position = INSTR(LEN(Filespec$) - 4, Filespec$, ".")
ELSE
Position = INSTR(Filespec$, ".")
END IF
IF (Position > 0) AND (Position < LEN(Filespec$)) THEN
Extension$ = MID$(Filespec$, Position)
ELSE
Extension$ = ""
END IF
END FUNCTION
FUNCTION FinishedFilespec$ (Filespec$, DefaultFilespec$)
' This FUNCTION is used internally by ParseFilespecs to supply
' any default filespec information not already supplied by
' the user.
IF LEN(BaseFilename$(Filespec$)) THEN
IF RIGHT$(Filespec$, 1) <> "." THEN
IF LEN(Extension$(Filespec$)) = 0 THEN _
Filespec$ = Filespec$ + Extension$(DefaultFilespec$)
END IF
ELSE
IF LEN(BaseFilename$(DefaultFilespec$)) THEN
Filespec$ = DefaultFilespec$
END IF
END IF
FinishedFilespec$ = Filespec$
END FUNCTION
REM $DYNAMIC
SUB GetLegalSwitches STATIC
' All of the information regarding the switches (and their
' aliases) is read here, according to the data format
' established in the main module (LegalSwitchList).
SHARED SwitchName$(), SwitchAlias$(), SwitchType(), _
NumericParameter() AS NumericParameterType, _
SwitchValue(), SwitchText$()
RESTORE LegalSwitchList ' For use when other data is added.
' LegalSwitchList data MUST BE PLACED
' LAST, AFTER ALL OTHER DATA.
'BEGINNING OF SECTION 3 OF 3 FOR QBX 7.X USERS
ON LOCAL ERROR GOTO GLSerror
DO
Index = Index + 1
REDIM PRESERVE SwitchName$(Index), SwitchAlias$(Index)
REDIM PRESERVE SwitchType(Index)
REDIM PRESERVE NumericParameter(Index) AS NumericParameterType
READ SwitchName$(Index),SwitchAlias$(Index),SwitchType(Index)
SELECT CASE SwitchType(Index)
CASE 0, 2, -2 ' Nothing more to read...
CASE 1, 3
READ NumericParameter(Index).Minimum,_
NumericParameter(Index).Maximum,_
NumericParameter(Index).Default
CASE -1, -3
READ NumericParameter(Index).Minimum,_
NumericParameter(Index).Maximum
CASE ELSE
ERROR 2 ' Syntax error (illegal data)
END SELECT
LOOP WHILE LEN(SwitchName$(Index))
IF Index > 1 THEN _
REDIM PRESERVE SwitchName$(Index - 1), _
SwitchAlias$(Index - 1),SwitchType(Index - 1), _
NumericParameter(Index - 1) AS NumericParameterType, _
SwitchValue(Index - 1), SwitchText$(Index - 1)
EXIT SUB
GLSerror: ' Intercepts "Out of data" error only
IF ERR = 4 THEN RESUME NEXT ELSE ERROR ERR
'END SECTION 3 OF 3 FOR QBX 7.X USERS
'BEGINNING OF SECTION 3 OF 3 FOR QB 4.X USERS
' FOR Index = 1 TO UBOUND(SwitchName$)
' READ SwitchName$(Index), SwitchAlias$(Index),_
' SwitchType(Index)
' SELECT CASE SwitchType(Index)
' CASE 0, 2, -2 ' Nothing more to read...
' CASE 1, 3
' READ NumericParameter(Index).Minimum,_
' NumericParameter(Index).Maximum,_
' NumericParameter(Index).Default
' CASE -1, -3
' READ NumericParameter(Index).Minimum,_
' NumericParameter(Index).Maximum
' CASE ELSE
' ERROR 2 ' Syntax error (illegal data)
' END SELECT
' NEXT Index
'END OF SECTION 3 OF 3 FOR QB 4.X USERS
END SUB
FUNCTION NumericSwitchValue (SwitchNameToCheck$)
' This FUNCTION looks up the value of a given switch, by the
' name of the switch. Of course, if no value was entered after
' the switch name a zero will be returned. Other possible
' values include &H8000 (if the switch was not found in
' COMMAND$) and &H8001 (meaning that this is a "text switch").
' Switch aliases are not allowed to be used to look up a value,
' in order to keep the code compact. Use of a "switch symbol"
' (/, etc.) before the name may be used, but is not required.
SHARED SwitchName$(), SwitchValue()
' The next instruction makes the FUNCTION somewhat "forgiving"
SwitchNameToCheck$ = BTRIM$(UCASE$(SwitchNameToCheck$))
IF INSTR(ValidSymbol$, LEFT$(SwitchNameToCheck$, 1)) THEN _
SwitchNameToCheck$ = LTRIM$(MID$(SwitchNameToCheck$, 2))
Index = 0
DO
Index = Index + 1
LOOP UNTIL (Index = UBOUND(SwitchName$)) OR _
(SwitchName$(Index) = SwitchNameToCheck$)
IF SwitchName$(Index) = SwitchNameToCheck$ THEN
NumericSwitchValue = SwitchValue(Index)
ELSE
NumericSwitchValue = &H8000
END IF
END FUNCTION
SUB ParseFilespecs (DefaultInputName$, DefaultOutputName$) STATIC
' This SUB builds input and output FileSpecs for use by other
' procedures, using the supplied filenames if none were entered
' from the DOS command line. Lone extensions may also be used
' for DefaultInputName$ and DefaultOutputName$; this is used
' to force a filename to be required, yet allowing a default
' extension to be used.
SHARED InputFilespec$, OutputFilespec$
DefaultInputName$ = UCASE$(BTRIM$(DefaultInputName$))
DefaultOutputName$ = UCASE$(BTRIM$(DefaultOutputName$))
IF INSTR(ValidSymbol$, LEFT$(COMMAND$, 1)) THEN
FileSpecParameters$ = ""
ELSE
FOR Index = 1 TO LEN(ValidSymbol$)
SymbolPosition = INSTR(COMMAND$,MID$(ValidSymbol$,Index,1))
IF SymbolPosition THEN _
IF (SymbolPosition < FirstSwitchPosition) OR _
(FirstSwitchPosition = 0) THEN _
FirstSwitchPosition = SymbolPosition
NEXT
IF FirstSwitchPosition THEN
FileSpecParameters$ = LEFT$(COMMAND$,FirstSwitchPosition-1)
ELSE
FileSpecParameters$ = COMMAND$
END IF
END IF
InBuild$ = FinishedFilespec$(BTRIM$(LEFT$(FileSpecParameters$,_
INSTR(FileSpecParameters$ + " ", " "))), DefaultInputName$)
OutBuild$ = FinishedFilespec$(BTRIM$(MID$(FileSpecParameters$,_
LEN(InBuild$) + 1)), DefaultOutputName$)
InputFilespec$ = InBuild$
OutputFilespec$ = OutBuild$
END SUB
SUB ParseSwitches STATIC
' This SUB parses COMMAND$, checks for proper switch syntax,
' proper parameter types and values, and also ensures that a
' switch is not duplicated. Custom errors may be generated, as
' follows:
' Error Code Condition
' ========== =========
' 200 Switch is illegal (not in LegalSwitchList)
' 201 Missing required switch parameter
' 202 Switch has a parameter but should not
' 203 Numeric/Text mismatch
' 204 Illegal parameter quantity
' 205 Switch has been duplicated
' Every switch will return a numeric value in the SwitchValue
' array. Note that the value &H8000 is initially assigned to
' each element to indicate that the switch wasn't found in
' COMMAND$. This is used to during the parsing process to
' determine if a switch is duplicated. Later, the application
' can determine if the switch was ever found in COMMAND$.
' The value &H8001 is assigned to those switches that have
' valid text data that should be read in the SwitchText$ array.
SHARED SwitchName$(), SwitchAlias$(), SwitchType(), _
NumericParameter() AS NumericParameterType, _
SwitchValue(), SwitchText$()
SHARED BadSwitch$ ' Used to refer to current switch name in
' error trapping, should that be necessary
FOR Index = 1 TO UBOUND(SwitchName$)
SwitchValue(Index) = &H8000
NEXT
IF LEN(COMMAND$) AND _
NOT (INSTR(ValidSymbol$, RIGHT$(COMMAND$, 1)) > 0) THEN
FOR Index = 1 TO LEN(ValidSymbol$)
SymbolPosition = INSTR(COMMAND$,MID$(ValidSymbol$,Index,1))
IF SymbolPosition THEN _
IF (SymbolPosition < Position) OR _
(Position = 0) THEN Position = SymbolPosition
NEXT
DO
NextPosition = 0 ' FOR...NEXT loop sets NextPosition to _
' lowest SymbolPosition past current _
' value of Position
FOR Index = 1 TO LEN(ValidSymbol$)
SymbolPosition = INSTR(Position + 1, COMMAND$, _
MID$(ValidSymbol$, Index, 1))
IF SymbolPosition THEN _
IF (SymbolPosition < NextPosition) OR _
(NextPosition = 0) THEN NextPosition=SymbolPosition
NEXT
IF NextPosition THEN
ParameterCheck$ = MID$(COMMAND$, Position + 1, _
NextPosition - (Position + 1))
ELSE
ParameterCheck$ = MID$(COMMAND$, Position + 1)
NextPosition = LEN(COMMAND$)
END IF
SwitchFound = FALSE
Index = 0
DO
Index = Index + 1
IF LEN(SwitchAlias$(Index)) THEN _
SwitchFound = (INSTR(ParameterCheck$, _
SwitchAlias$(Index)) = 1)
LOOP UNTIL (SwitchFound) OR Index = UBOUND(SwitchName$)
BadSwitch$ = LEFT$(ValidSymbol$, 1) + SwitchName$(Index)
IF SwitchFound THEN
IF SwitchValue(Index) = &H8000 THEN
Position = Position + LEN(SwitchAlias$(Index)) + 1
SwitchValue(Index) = 0
ELSE
ERROR 205 ' Duplicate switch
END IF
ELSE
Index = 0
DO
Index = Index + 1
SwitchFound = (INSTR(ParameterCheck$, _
SwitchName$(Index)) = 1)
LOOP UNTIL (SwitchFound) OR Index = UBOUND(SwitchName$)
BadSwitch$ = LEFT$(ValidSymbol$, 1) + SwitchName$(Index)
IF SwitchFound THEN
IF SwitchValue(Index) = &H8000 THEN
Position = Position + LEN(SwitchName$(Index)) + 1
SwitchValue(Index) = 0
ELSE
ERROR 205 ' Duplicate switch
END IF
ELSE
BadSwitch$ = LEFT$(ValidSymbol$, 1) + ParameterCheck$
IF INSTR(BadSwitch$, ":") > 2 THEN _
BadSwitch$ = _
LEFT$(BadSwitch$, INSTR(BadSwitch$, ":") - 1)
ERROR 200 ' Illegal switch
END IF
END IF
IF SwitchFound THEN
IF (MID$(COMMAND$, Position, 1) = ":") AND _
(Position < LEN(COMMAND$)) THEN Position = Position+1
IF NextPosition < LEN(COMMAND$) THEN
ParameterCheck$ = BTRIM$(MID$(COMMAND$, Position, _
NextPosition - Position))
ELSE
ParameterCheck$ = LTRIM$(MID$(COMMAND$, Position))
END IF
IF LEN(ParameterCheck$) THEN
IF SwitchType(Index) = 0 THEN
ERROR 202 ' Parameter not allowed!
ELSE
IF INSTR("0123456789",LEFT$(ParameterCheck$, 1)) THEN
IF ABS(SwitchType(Index)) = 2 THEN
ERROR 203 ' Switch parameter type mismatch
ELSE
SwitchValue(Index) = VAL(ParameterCheck$)
IF (SwitchValue(Index) < _
NumericParameter(Index).Minimum) OR _
(SwitchValue(Index) > _
NumericParameter(Index).Maximum) THEN _
ERROR 204 ' Illegal quantity
END IF
ELSE
IF ABS(SwitchType(Index)) = 1 THEN
ERROR 203 ' Switch parameter type mismatch
ELSE
SwitchText$(Index) = ParameterCheck$
' Indicates that there is valid text in SwitchText$(Index)..
SwitchValue(Index) = &H8001
END IF
END IF
END IF
ELSE
IF SwitchType(Index) < 0 THEN
ERROR 201 ' Parameter required!
ELSEIF SwitchType(Index) = 2 THEN
' Indicates that the value of SwitchText$(Index) is the null text
SwitchValue(Index) = &H8001
ELSE
SwitchValue(Index) = NumericParameter(Index).Default
END IF
END IF
END IF
Position = NextPosition
LOOP UNTIL Position = LEN(COMMAND$)
END IF
END SUB
SUB RunParseEngine STATIC
' This SUB demonstrates how the components of the "Parse
' Engine" work together.
SHARED SwitchName$(), SwitchAlias$(), SwitchType()
SHARED NumericParameter() AS NumericParameterType,SwitchText$()
SHARED SwitchTextData$ ' For use only if SwitchVal
' returns a value of &H8006
SHARED InputFilespec$, OutputFilespec$
Q$ = CHR$(34)
PRINT
PRINT "CMDPARSE - DOS Command Line "; q$; "Parse Engine"; q$
PRINT "Copyright (c)1991 Barry L. Camp - All Rights Reserved"
PRINT
PRINT "COMMAND$ : "; q$; COMMAND$; q$
GetLegalSwitches
ParseFilespecs "TESTFILE.IN", "TESTFILE.OUT"
PRINT "Input File : "; q$; InputFilespec$; q$
PRINT "Output File: "; q$; OutputFilespec$; q$
PRINT
ParseSwitches
IF LEN(SwitchName$(1)) THEN
FOR Index = 1 TO UBOUND(SwitchName$)
PRINT "Value of "; q$; LEFT$(ValidSymbol$, 1); _
SwitchName$(Index); q$; " is ";
Value = NumericSwitchValue(SwitchName$(Index)) ' BYVAL
SELECT CASE Value
CASE &H8000
PRINT "undefined (switch not found in COMMAND$)"
CASE &H8001
PRINT q$; SwitchText$(Index); q$
CASE ELSE
PRINT MID$(STR$(Value), 2)
END SELECT
NEXT
ELSE
PRINT "No legal switches were defined."
END IF
END SUB
FUNCTION TextSwitchValue$ (SwitchNameToCheck$) STATIC
' This FUNCTION looks up the "text value" of a given switch, by
' the name of the switch. "Text value" means the text of the
' non-numeric parameter following the switch name (and the
' optional colon). Of course, if no text was entered after the
' switch name (or this is not a "text switch"), then a null
' string is returned. Switch aliases are not allowed to be used
' to look up a text value, in order to keep the code compact.
' Use of a "switch symbol" (/, etc.) before the name may be
' used, but is not required.
SHARED SwitchName$(), SwitchText$()
' this makes the FUNCTION somewhat "forgiving"...
SwitchNameToCheck$ = BTRIM$(UCASE$(SwitchNameToCheck$))
IF INSTR(ValidSymbol$, LEFT$(SwitchNameToCheck$, 1)) THEN _
SwitchNameToCheck$ = LTRIM$(MID$(SwitchNameToCheck$, 2))
Index = 0
DO
Index = Index + 1
LOOP UNTIL (Index = UBOUND(SwitchName$)) OR _
(SwitchName$(Index) = SwitchNameToCheck$)
IF SwitchName$(Index) = SwitchNameToCheck$ THEN
TextSwitchValue$ = SwitchText$(Index)
ELSE
TextSwitchValue$ = ""
END IF
END FUNCTION